home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 001_100 / DISK0026 / DISK0026.ZIP / MERGE.PAS < prev    next >
Pascal/Delphi Source File  |  1983-01-13  |  4KB  |  189 lines
  1. {$debug-}
  2.  
  3. program merge (output,infile_1,infile_2,outfile);
  4.  
  5. var
  6.   infile_1        : text;
  7.   infile_2        : text;
  8.   outfile         : text;
  9.   in1,in2         : lstring (255);
  10.   up1,up2         : lstring (255);
  11.   onecount        : word;
  12.   twocount        : word;
  13.   outcount        : word;
  14.  
  15. procedure read1;
  16.   var [static] 
  17.     i : word;
  18.   begin
  19.     while in1.len = 0 do
  20.       begin
  21.         if eof (infile_1) then
  22.           return;
  23.         readln (infile_1,in1);
  24.         if in1.len > 80 then
  25.           in1.len := 80;
  26.         for i := in1.len downto 1 do
  27.           if in1 [i] =  ' ' then
  28.             in1.len := in1.len - 1
  29.           else
  30.             break;
  31.         up1 := in1;
  32.         for i := 1 to up1.len do
  33.           if up1 [i] in ['a'..'z'] then
  34.             up1 [i] := chr (ord (up1 [i]) - 32);
  35.         if up1 <> null then
  36.           onecount := onecount + 1;
  37.       end;
  38.   end;
  39.           
  40. procedure read2;
  41.   var [static] 
  42.     i : word;
  43.   begin
  44.     while in2.len = 0 do
  45.       begin
  46.         if eof (infile_2) then
  47.           return;
  48.         readln (infile_2,in2);
  49.         if in2.len > 80 then
  50.           in2.len := 80;
  51.         for i := in2.len downto 1 do
  52.           if in2 [i] =  ' ' then
  53.             in2.len := in2.len - 1
  54.           else
  55.             break;
  56.         up2 := in2;
  57.         for i := 1 to up2.len do
  58.           if up2 [i] in ['a'..'z'] then
  59.             up2 [i] := chr (ord (up2 [i]) - 32);
  60.         if up2 <> null then
  61.           twocount := twocount + 1;
  62.       end;
  63.   end;
  64.           
  65. procedure write1;
  66.   begin
  67.     if up1 <> null then
  68.       begin
  69.         outcount := outcount + 1;
  70.         writeln (outfile,in1);
  71.         in1 := null;
  72.         up1 := null;
  73.       end;
  74.     read1;
  75.   end;
  76.  
  77. procedure write2;
  78.   begin
  79.     if up2 <> null then
  80.       begin
  81.         outcount := outcount + 1;
  82.         writeln (outfile,in2);
  83.         in2 := null;
  84.         up2 := null;
  85.       end;
  86.     read2;
  87.   end;
  88.  
  89. function one_greater : boolean;
  90.   var [static]
  91.     k       : word;
  92.     last    : word;
  93.   begin
  94.     if up1.len > up2.len then
  95.       last := up2.len
  96.     else
  97.       last := up1.len;
  98.     if last = 0 then
  99.       begin
  100.         if up2.len > 0 then
  101.           one_greater := true
  102.         else
  103.           one_greater := false;
  104.         return;
  105.       end;
  106.     if last < 8 then
  107.       begin
  108.         one_greater := false;
  109.         return;
  110.       end;
  111.     for k := 8 to last do
  112.       begin
  113.         if up1 [k] < up2 [k] then
  114.           begin
  115.             one_greater := false;
  116.             return;
  117.           end;
  118.         if up1 [k] > up2 [k] then
  119.           begin
  120.             one_greater := true;
  121.             return;
  122.           end;
  123.       end;
  124.     if up1.len > up2.len then
  125.       begin
  126.         one_greater := true;
  127.         return;
  128.       end;
  129.     if up1.len < up2.len then
  130.       begin
  131.         one_greater := false;
  132.         return;
  133.       end;
  134.     for k := 1 to 6 do
  135.       begin
  136.         if up1 [k] < up2 [k] then
  137.           begin
  138.             one_greater := false;
  139.             return;
  140.           end;
  141.         if up1 [k] > up2 [k] then
  142.           begin
  143.             one_greater := true;
  144.             return;
  145.           end;
  146.       end;
  147.     one_greater := false;
  148.   end;
  149.           
  150. procedure initialize;
  151.   begin
  152.     onecount := 0;
  153.     twocount := 0;
  154.     outcount := 0;
  155.     in1 := null;
  156.     up1 := null;
  157.     in2 := null;
  158.     up2 := null;
  159.     writeln;
  160.     writeln ('Index merging program, (C) Copyright Peter Norton 1983');
  161.     writeln;
  162.     reset (infile_1);
  163.     reset (infile_2);
  164.     rewrite (outfile);
  165.     read1;
  166.     read2;
  167.   end;
  168.  
  169. procedure finish_up;
  170.   begin
  171.     if one_greater then
  172.       write2;
  173.     write1;
  174.     write2;
  175.     writeln (onecount,' entries in from one file;');
  176.     writeln (twocount,' entries in from the other file;');
  177.     writeln (outcount,' combined entries written.');
  178.   end;
  179.   
  180. begin
  181.   initialize;
  182.   while (not eof (infile_1)) or (not eof (infile_2)) do
  183.     if one_greater then
  184.       write2
  185.     else
  186.       write1;
  187.   finish_up;
  188. end.
  189.